home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / PGM_TOOL / PREVIEW / WPREVIEW.PAS < prev    next >
Pascal/Delphi Source File  |  1995-11-12  |  55KB  |  1,848 lines
  1. Unit wPreview;
  2.  
  3. interface
  4.  
  5. uses
  6.   Forms, SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Dialogs, ExtCtrls, ShellApi, BTprint, StdCtrls, Buttons, Menus,
  8.   Misc;
  9.  
  10. const PrnInitFile='PrnInit.txt';
  11.       MaxLpTitles=20;     { Max jobs printing at one time }
  12.       MaxPrns=20;         { Max printers }
  13.       MaxQTypes=10;       { Max Defined Queues }
  14.       MaxFonts=10;        { Max Defined Fonts }
  15.       MaxPageLen=58;      { Max lines per page (text style printing) }
  16.             MaxPages=30;        { Max pages per report (if you want previewing) }
  17.       ScrnCanvasX=820;    { Image width and height for preview image box }
  18.       ScrnCanvasY=940;
  19.       ScrnRowHeight=900;  { Vertical height of canvas for tight
  20.                             Vertical spacing }
  21.             RefPixPerInchX=300; { Reference printer pixels per inch horizontal }
  22.             RefPixPerInchY=300; { Reference printer pixels per inch vertical }
  23.       RefAspectYdbl:double=300.0;  { Used in cmX() and cmY() }
  24.       RefAspectXdbl:double=300.0;
  25.       ScrnPixPerInchX=70; { GetDeviceCaps() returns 96, I prefer 70 }
  26.       ScrnPixPerInchY=70; { Calc by measuring your screen image and dividing
  27.                             into your screen densities: 640x480, 800x600 }
  28.       ScrollPixels=20;    { When viewing section of large BMP's, scroll 1/2" }
  29.       { following are passed to StartDoc() }
  30.       For8x11=false;  { Report designed for 8.5x11 paper size }
  31.       For14x11=true;  { Report designed for 14x11 paper size }
  32.             Dlm='|';        { Delimiter used by AddCommand(), can be more than
  33.                               one char if a conflict }
  34.  
  35. type
  36.     PrnInfo=Record
  37.         { It may be available but no selectable in the Printer Select window }
  38.         PrName:string[30];  { Printer name as it appears in win.ini }
  39.     PrPort:string[40];   { Lpt?, 1..3 }
  40.         Queue:string[30];      { Queue name as it appears in Network setup }
  41.       CanSelect:boolean;  { Will appear in Select Printer window }
  42.     PrType:integer;     { Printer Type, see PRNINIT.TXT, associates queues }
  43.         PrWide:Boolean;     { Wide carriage style printer? }
  44.     end;
  45.   LPMain=class(TObject)
  46.         public
  47.             LptPrinters:array [1..MaxPrns] of PrnInfo;
  48.       PrnCnt,AvailCnt,QueueCnt:integer;
  49.       AvailType:array [1..MaxPrns] of integer;
  50.       QueueType:array [1..MaxPrns,1..MaxQTypes] of integer;
  51.       AvailName,QueueName,QueueTitle:array [1..MaxPrns] of string[40];
  52.             AvailWide:array [1..MaxPrns] of boolean;
  53.       { fixed width fonts }
  54.       FontList:array [1..MaxFonts] of string[40]; { Over 5 are variable width }
  55.       { CurDest, WantsPreview set in Select Printer window }
  56.             CurDest:integer;       { Current hardcopy destination }
  57.       WantsPreview:boolean;  { Wants Report Preview }
  58.             LastHardCopy:integer;  { Last hardcopy printer selected }
  59.             procedure LoadPrinters(FromFile:string);
  60.       function  CurrentPrinterInfo:string;
  61.             procedure GetPrinterType(aPrinterName:string;var pType:integer;
  62.         pWideCarriage:boolean);
  63.             function  GetQueueNum(ForQueue:string):Integer;
  64.     end;
  65.   TPreview = class(TForm)
  66.     Image1: TImage;
  67.     Panel1: TPanel;
  68.     Label1: TLabel;
  69.     Panel2: TPanel;
  70.     Label3: TLabel;
  71.     BitBtn6: TBitBtn;
  72.     BitBtn1: TBitBtn;
  73.     Button1: TButton;
  74.     Button2: TButton;
  75.     Button3: TButton;
  76.     Button4: TButton;
  77.     Label4: TLabel;
  78.     Edit1: TEdit;
  79.     PopupMenu1: TPopupMenu;
  80.     Close1: TMenuItem;
  81.     N1: TMenuItem;
  82.     FirstPg1: TMenuItem;
  83.     PreviousPg1: TMenuItem;
  84.     NextPg1: TMenuItem;
  85.     LastPg1: TMenuItem;
  86.     N2: TMenuItem;
  87.     PrintAll1: TMenuItem;
  88.     PrintPg1: TMenuItem;
  89.     Image2: TImage;
  90.     GoToPg1: TMenuItem;
  91.     N3: TMenuItem;
  92.     Panel3: TPanel;
  93.     Label2: TLabel;
  94.     Label5: TLabel;
  95.     Label6: TLabel;
  96.     procedure FormCreate(Sender: TObject);
  97.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  98.     procedure BitBtn6Click(Sender: TObject);
  99.     procedure BitBtn1Click(Sender: TObject);
  100.     procedure Button3Click(Sender: TObject);
  101.     procedure Button4Click(Sender: TObject);
  102.     procedure Button2Click(Sender: TObject);
  103.     procedure Button1Click(Sender: TObject);
  104.     procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  105.     procedure Close1Click(Sender: TObject);
  106.     procedure FirstPg1Click(Sender: TObject);
  107.     procedure PreviousPg1Click(Sender: TObject);
  108.     procedure NextPg1Click(Sender: TObject);
  109.     procedure LastPg1Click(Sender: TObject);
  110.     procedure PrintAll1Click(Sender: TObject);
  111.     procedure PrintPg1Click(Sender: TObject);
  112.     procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
  113.       Shift: TShiftState; X, Y: Integer);
  114.     procedure Image2MouseUp(Sender: TObject; Button: TMouseButton;
  115.       Shift: TShiftState; X, Y: Integer);
  116.     procedure GoToPg1Click(Sender: TObject);
  117.     procedure FormActivate(Sender: TObject);
  118.   private
  119.     wCommands:array [1..MaxPages] of tstringlist;
  120.     ViewPageTot:integer;  { Internal Page Counter For Commands[] }
  121.     CurPage:integer;      { Current Page Being Displayed }
  122.     wCurDest:integer;     { Next three items set by Lpr before finishing }
  123.     wRpWide:boolean;
  124.         wShortTitle:string;
  125.     wPageTot:integer;
  126.     Zoomable,FitToScreen:boolean;
  127.     BigX,BigY:integer;
  128.     FirstTimeBig:boolean;
  129.     useLandScape:boolean;    { Set before calling PlayBackPage }
  130.         function  PlayBackPage(ToScreen:boolean;PageNum:integer):boolean;
  131.         procedure SaveCommands(toFile:string);
  132.     procedure SetButtons;
  133.         procedure ShowBigImage;
  134.         procedure LoadCommands(fromFile:string);
  135.   public
  136.         procedure ShowBluePrint(aCaption,TinyBMP,FullBMP:string);
  137.         procedure PrintBluePrint(FullBMP:string);
  138.         procedure PrintCommandFile(aLoadSpec:string);
  139.   end;
  140.   lpr=class(TObject)
  141.       private
  142.             Row,Col:Integer;        { Current printer row,col for TextStyle }
  143.             RpWide,FixedWidth:Boolean;      { Report width, true if greater than 80 }
  144.       RowHeight,ColWidth,Fixed10Width,Fixed12Width,Fixed8Width:integer;
  145.       AdjZeroX,AdjZeroY:double; {Used 0,0 offset, in centimeters}
  146.             Preview: TPreview;
  147.       aCanvas:TCanvas;        { Actual display surface }
  148.             NumOfCopies:Integer;    { Number of copies }
  149.             CurDest:integer;        { Current hardcopy destination }
  150.             CurFont:integer;        { Used in SetGDIFont }
  151.       Condensed:boolean;      { Use condensed print }
  152.       RowColStyle:boolean;    { Set type of text, set using SetTextStyle }
  153.             FromPreview:boolean;    { Used by StartDoc2 and Preview window }
  154.         useLandScape:boolean;   { Set in StartDoc }
  155.             Commands:array [1..MaxPages] of tstringlist;
  156.             ViewPageTot:integer;          { Used with Commands to track pages }
  157.             InsideCommand:boolean;  { Stop recursion of AddCommand() }
  158.       ScaleXby,ScaleYby:longint;
  159.       FromLoadToPrint:boolean; { Load an print a command file }
  160.             procedure StartDoc2(ToPreview,Over80Wide:boolean;
  161.               aBriefTitle:string);  { Only used by Preview window }
  162.           { Prints text to selected canvas: screen or printer }
  163.             procedure Wout(xpos,ypos:integer;aStr:string);
  164.                 { Use to change font and style to one of FontList[] items }
  165.             procedure setGDIfont(NewFont:string); { set by pxText() }
  166.           { The following is used to correct alignment,
  167.             base reference printer is 300 dpi,
  168.                     see RefAspectX and RefAspectY below }
  169.       procedure SetScaleXY;
  170.       procedure SetScaleXY70;
  171.  
  172.                 { Scale reference pixels to current canvas }
  173.       function  ScaleX(RefX:integer):integer;
  174.       function  ScaleY(RefY:integer):integer;
  175.                 { Easy way to lay out forms, use centimeters from top and left
  176.                     edge to position items, then print once on printer it is to be
  177.                     used on, add the adjustments to list in SetZeroXY() routine to
  178.                     correct 0,0 position, for pre-printed forms }
  179.       procedure SetZeroXY(aPrType:integer);
  180.         public
  181.             ShortTitle:string[70];
  182.             Line,Page,PGlen:integer;
  183.       WantsPreview:boolean;  { Wants report previewing }
  184.             WindowDest:boolean;    { Raster ops are going to a Window }
  185.       PrePrintedForm:boolean; { After SetDestination }
  186.       pr:TPrinter;        { Used when printing hardcopy }
  187.       { The following vars used to correct alignment when using the
  188.         Windows printing system, adjusted proportionally to reference printer
  189.         output }
  190.       RefAspectX,RefAspectY,PrnAspectY,PrnAspectX:integer;
  191.       CanvasWidth,CanvasHeight:integer;
  192.       Running,Abort:boolean;
  193.       CancelState:integer;
  194.       constructor Create;
  195.             procedure StartDoc(Over80Wide:boolean;aBriefTitle:string);
  196.             procedure StopDoc;
  197.              procedure SetCaption(toStr:string);
  198.             procedure SetDestination; { Call before StartDoc() }
  199.       procedure ForceToScreen;  { These two must be after SetDestination, }
  200.       procedure ForceToPrinter; { Before StartDoc, to override default dest. }
  201.         function  Cancel:integer; { 0-not running, 1-continue, 2-abort }
  202.             { Key print commands should start with AddCommand
  203.               and end with EndCommand to keep recursion from occuring }
  204.             procedure AddCommand(CommandStr:string);
  205.             procedure EndCommand;
  206.       procedure SetTextStyle(forText:boolean);
  207.  
  208.       { the following are used to emulate a line printer }
  209.             procedure TextFont(NewFont:string); { chng font for line printer style }
  210.             procedure Write(astr:string);
  211.             procedure WriteLn(astr:string);
  212.             procedure P(atrow,atcol:integer;astr:string);
  213.             procedure SetRowCol(toRow,toCol:integer);
  214.             function  pRow:integer;
  215.             function  pCol:integer;
  216.             procedure CrLf;
  217.             procedure Eject;  { used for both Text and Raster styles }
  218.             { converts designated chars to alternate types, for engineering }
  219.             function  SpecChars(istr:string):string;
  220.  
  221.       { the following are used for X,Y canvas-style printing, params are
  222.               in Centimeters, easy way to position items, translates Centimeters
  223.                 to Reference pixels, then passes to px???? commands }
  224.             procedure cmLine(left,top,width,height:double);
  225.             procedure cmBox(left,top,width,height:double;graylev:integer);
  226.             procedure cmText(left,top:double;uzfont,thetext:string);
  227.             procedure cmImage(IsColor:boolean;left,top:double;
  228.                                                 ScrnBMP,PrintBMP:string);
  229.             procedure cmBarCode(left,top,width,height:double;Text:string);
  230.  
  231.       { actual routines used for X,Y raster printing, params are
  232.               in current reference Pixels and use ScaleX and ScaleY to
  233.         convert to current canvas pixels, usually called by cm??? }
  234.             { aRect values are: left, top, width, height }
  235.             procedure pxLine(aRect:Trect);
  236.             procedure pxText(aPoint:TPoint;uzFont,TheText:string);
  237.             procedure pxImage(IsColor:boolean;aRect:Trect;ScrnBMP,PrintBMP:string);
  238.             procedure pxOrientation(newOrientation:TPrinterOrientation);
  239.             procedure pxBarCode(aRect:Trect;Text:string);
  240.             procedure pxBox(aRect:Trect;GrayLev:integer);
  241.             procedure pxTray(UseTray:integer);
  242.             procedure pxRaster(Left,Top,Width,Height,Density:integer;FileName:string);
  243.     end;
  244.  
  245. var lp:LPmain;  { Contains printer descriptions and setups }
  246.     { List of currently active printing windows or jobs in progress }
  247.         CurPrinting:array [1..MaxLpTitles] of string30; 
  248. procedure StartLinePrinter;  { Call in the MainForm's FormCreate method }
  249. procedure StopLinePrinter;   { Call in the MainForm's FormClose method }
  250. procedure DirectToPrinter(anEscSeq:string);
  251. function  cmX(Centimeters:double):integer; { Centimeters to ref. pixels }
  252. function  cmY(Centimeters:double):integer;
  253.  
  254. implementation
  255.  
  256. {$R *.DFM}
  257.  
  258.  
  259. { WNetGetConnection>0 no queue attached, 0-Queue name returned in RemoteName }
  260. function  WNetGetConnection(LocalDev,RemoteName:Pchar;
  261.                                                         var RetSize:integer):integer;far;external 'USER';
  262.  
  263. function GetTitle(aStr:string):string;
  264. var ii:integer;
  265. begin
  266.   ii:=pos('::',upper(aStr));
  267.   result:=aStr;
  268.   if ii>0 then begin
  269.     result:=ltrim(trim(substr(aStr,ii+2,70)));
  270.   end;
  271.   ii:=pos(Dlm+Dlm,aStr);
  272.   if ii>10 then result:=substr(aStr,ii+2,70);
  273. end;
  274.  
  275. procedure TPreview.FormCreate(Sender: TObject);
  276. var ii:integer;
  277. begin
  278.   width:=627;
  279.   height:=423;
  280.   left:=0;
  281.   top:=0;
  282.     centerhoriz(self);
  283.     Gen.AddWin('Preview',self);
  284.   CurPage:=1;
  285.     image1.width:=ScrnCanvasX;
  286.   image1.height:=ScrnCanvasY;
  287.   panel1.width:=image1.width;
  288.     for ii:=1 to MaxPages do wCommands[ii]:=nil;
  289.   Zoomable:=false;
  290.   FitToScreen:=false;
  291.   useLandScape:=false;
  292. end;
  293.  
  294. procedure TPreview.FormClose(Sender: TObject; var Action: TCloseAction);
  295. var bool:boolean;
  296.     ii:integer;
  297. begin
  298.   bool:=true;
  299.   if pin('FORMAT',upper(caption)) then begin
  300.     bool:=YesNoBox('Close Preview Window During Formatting?');
  301.   end;
  302.   if bool then begin
  303.       for ii:=1 to wPageTot do begin
  304.           if wCommands[ii]<>nil then wCommands[ii].free;
  305.         end;
  306.       if Zoomable then begin
  307.         Gen.InBluePrint:=false;
  308.         Gen.FullBP.free;  { free memory }
  309.         Gen.FullBP:=TBitMap.Create;
  310.         Gen.TinyBP.free;  { free memory }
  311.       Gen.TinyBP:=TBitMap.Create;
  312.       end;
  313.         Gen.ReleaseWin(self);
  314.       action:=caFree;
  315.   end;
  316. end;
  317.  
  318. procedure Lpr.Wout(xpos,ypos:integer;aStr:string);
  319. var ii,jj,orgx:integer;
  320.     tt:string[20];
  321. begin
  322.   { xpos, ypos should be in canvas pixels }
  323.   jj:=length(astr);
  324.   if jj>0 then begin
  325.     with aCanvas do begin
  326.       brush.style:=bsClear;
  327.       if FixedWidth then begin
  328.         if not RowColStyle then begin
  329.           if WindowDest then begin
  330.             ColWidth:=Fixed12Width;
  331.             if font.size=10 then ColWidth:=Fixed10width;
  332.             if font.size=8 then ColWidth:=Fixed8width;
  333.           end else begin
  334.             ColWidth:=Colwidth-1;
  335.             if font.size=10 then ColWidth:=Colwidth-1;
  336.             if font.size=8 then ColWidth:=Colwidth;
  337.           end;
  338.         end;
  339.         orgx:=xpos;
  340.         { adjust text spacing so a full will fit within the canvas width }
  341.         for ii:=1 to jj do begin
  342.           tt:=copy(astr,ii,1);
  343.           xpos:=orgx+(ii-1)*ColWidth;
  344.           textout(xpos,ypos,tt);
  345.           { Corporate Mono won't produce underlines, have to use Courier }
  346.           if (fsUnderline in font.style) and (font.name=lp.FontList[2]) then begin
  347.             font.name:=lp.FontList[1];
  348.             textout(xpos,ypos,'_');
  349.             font.name:=lp.FontList[2];
  350.           end;
  351.         end;
  352.       end else begin
  353.         textout(xpos,ypos,astr);
  354.       end;
  355.     end;
  356.   end;
  357. end;
  358.  
  359. procedure TPreview.PrintBluePrint(FullBMP:string);
  360. var tlp:TPrinter;
  361.     PrintBP:TBitmap;
  362.     tcanvas:trect;
  363.     ii,jj:integer;
  364.     tt:string;
  365. begin
  366.   caption:='Print B/P';
  367.   windowstate:=wsMinimized;
  368.   tlp:=TPrinter.create;
  369.   tlp.orientation:=poLandScape;
  370.   tlp.printerindex:=lp.curdest-1;
  371.   tlp.begindoc;
  372.   PrintBP:=tbitmap.create;
  373.   PrintBP.loadfromfile(FullBMP);
  374.   tlp.fCanvas.copyrect(tlp.fCanvas.cliprect,PrintBP.canvas,
  375.     PrintBP.canvas.cliprect);
  376.   tlp.enddoc;
  377.   tlp.destroy;
  378.   PrintBp.free;
  379.   close;
  380. end;
  381.  
  382. procedure Lpr.SetTextStyle(forText:boolean);
  383. begin
  384.     if WantsPreview then begin
  385.     if forText<>RowColStyle then
  386.       AddCommand(' 5'+Dlm+iifs(forText,'TRUE','FALSE'));
  387.   end;
  388.   RowColStyle:=forText;
  389.   EndCommand;
  390. end;
  391.  
  392. procedure Lpr.setGDIfont(NewFont:string);
  393. var ii,jj,OrgFont:integer;
  394.     tstyle:tfontstyles;
  395. begin
  396.   if not empty(NewFont) then begin
  397.     OrgFont:=CurFont;
  398.     with aCanvas do begin
  399.       tstyle:=font.style;
  400.       { when changing font type, must use style '1:12b', where '1:' is style }
  401.       if pin(':',NewFont) then begin
  402.         jj:=pos(':',NewFont);
  403.         if CurFont=0 then CurFont:=2;  { default font type }
  404.         if jj>1 then begin
  405.           ii:=procint(copy(NewFont,1,jj));
  406.           NewFont:=copy(NewFont,jj+1,35);
  407.             if (ii>0) and (ii<=MaxFonts) then begin
  408.               if not empty(lp.FontList[ii]) then CurFont:=ii
  409.             else begin
  410.               if ii<6 then CurFont:=1 else Curfont:=6;
  411.             end;
  412.             end;
  413.         end;
  414.         if orgfont>0 then begin
  415.           if CurFont<>orgfont then begin
  416.             font.name:=lp.FontList[CurFont];
  417.           end;
  418.         end else font.name:=lp.FontList[CurFont];
  419.       end;
  420.       FixedWidth:=(CurFont<6);
  421.       if not WindowDest then begin
  422.           if upin('Generic',lp.LptPrinters[CurDest].PrName) then begin
  423.           { cannot condense text, must layout to fit page as is }
  424.           CurFont:=1;  { Courier }
  425.           font.name:=lp.FontList[CurFont];
  426.           FixedWidth:=false;  { just print as is in wOut() }
  427.         end;
  428.       end;
  429.       { if change size, must also reset style }
  430.       if procint(NewFont)>0 then begin
  431.         font.size:=procint(NewFont);
  432.         font.color:=clBlack;
  433.           tstyle:=[];
  434.       end;
  435.       if pin('B',upper(NewFont)) then begin
  436.         Include(tstyle,fsbold);
  437.         if CurFont=2 then begin
  438.           CurFont:=3;
  439.             font.name:=lp.FontList[CurFont];
  440.         end;
  441.       end;
  442.       if pin('U',upper(NewFont)) then Include(tstyle,fsUnderline);
  443.       if pin('I',upper(NewFont)) then Include(tstyle,fsItalic);
  444.       { set back to normal }
  445.       if pin('N',upper(NewFont)) then begin
  446.         if CurFont=3 then begin  { Corporate Mono Bold, back to normal }
  447.           CurFont:=2;
  448.             font.name:=lp.FontList[CurFont];
  449.         end;
  450.           tstyle:=[];
  451.       end;
  452.       font.style:=tstyle;
  453.       if WindowDest then RowHeight:=ScrnRowHeight div 60
  454.       else RowHeight:=CanvasHeight div 60;
  455.       if CurFont<6 then begin
  456.         if WindowDest then begin
  457.             Fixed12Width:=((CanvasWidth-25) div 80)+1;
  458.             Fixed10Width:=(CanvasWidth-25) div 104;
  459.             Fixed8Width:=(CanvasWidth-25) div 132;
  460.         end else begin
  461.             Fixed12Width:=CanvasWidth div 80;
  462.             Fixed10Width:=CanvasWidth div 104;
  463.             Fixed8Width:=CanvasWidth div 132;
  464.         end;
  465.       end;
  466.       ColWidth:=CanvasWidth div (80+1);  { 12 pt }
  467.          if font.size=8 then ColWidth:=CanvasWidth div (132+1);
  468.          if font.size=10 then ColWidth:=CanvasWidth div (104+1);
  469.     end;
  470.   end;
  471. end;
  472.  
  473. procedure Lpr.SetScaleXY;
  474. var t1,t2:longint;
  475. begin
  476.   CanvasWidth:=acanvas.cliprect.right;
  477.   CanvasHeight:=acanvas.cliprect.bottom;
  478.   RefAspectX:=RefPixPerInchX;
  479.   RefAspectY:=RefPixPerInchY;
  480.     PrnAspectX:=GetDeviceCaps(acanvas.handle,LOGPIXELSX);
  481.   PrnAspectY:=GetDeviceCaps(acanvas.handle,LOGPIXELSY);
  482.   { for Screen is 96, squeeze a little tighter }
  483.   if WindowDest then begin
  484.     PrnAspectY:=PrnAspectY-4;
  485.   end;
  486.   { ScaleXby and ScaleYby used to adjust reference pixels to
  487.     actual pixels }
  488.   t1:=PrnAspectX;
  489.   t2:=RefAspectX;
  490.   ScaleXby:=(t1*100) div t2;
  491.   t1:=PrnAspectY;
  492.   t2:=RefAspectY;
  493.   ScaleYby:=(t1*100) div t2;
  494. end;
  495.  
  496. procedure Lpr.SetScaleXY70;
  497. var t1,t2:longint;
  498. begin
  499.   CanvasWidth:=acanvas.cliprect.right;
  500.   CanvasHeight:=acanvas.cliprect.bottom;
  501.   RefAspectX:=RefPixPerInchX;
  502.   RefAspectY:=RefPixPerInchY;
  503.   if WindowDest then begin
  504.       PrnAspectX:=ScrnPixPerInchX;
  505.       PrnAspectY:=ScrnPixPerInchX;
  506.   end else begin
  507.       PrnAspectX:=GetDeviceCaps(acanvas.handle,LOGPIXELSX);
  508.       PrnAspectY:=GetDeviceCaps(acanvas.handle,LOGPIXELSY);
  509.     end;
  510.   { ScaleXby and ScaleYby used to adjust reference pixels to
  511.     actual pixels }
  512.   t1:=PrnAspectX;
  513.   t2:=RefAspectX;
  514.   ScaleXby:=(t1*100) div t2;
  515.   t1:=PrnAspectY;
  516.   t2:=RefAspectY;
  517.   ScaleYby:=(t1*100) div t2;
  518. end;
  519.  
  520. function  Lpr.ScaleX(RefX:integer):integer;
  521. var longx:longint;
  522. begin
  523.   longx:=RefX;
  524.   Result:=(longx*ScaleXby) div 100;
  525. end;
  526.  
  527. function  Lpr.ScaleY(RefY:integer):integer;
  528. var longy:longint;
  529. begin
  530.   longy:=RefY;
  531.   Result:=(longy*ScaleYby) div 100;
  532. end;
  533.  
  534. constructor lpr.Create;
  535. var ii:integer;
  536. begin
  537.   inherited create;
  538.   Abort:=false;
  539.   Running:=false;
  540.   Preview:=nil;
  541.   AdjZeroX:=0.0;
  542.   AdjZeroY:=0.0;
  543.     FromPreview:=false;
  544.   WantsPreview:=false;
  545.   WindowDest:=false;
  546.   PrePrintedForm:=false;
  547.     for ii:=1 to MaxPages do Commands[ii]:=nil;
  548. end;
  549.  
  550. function  LPmain.CurrentPrinterInfo:string;
  551. begin
  552.   result:='';
  553.   if lp.CurDest>0 then begin
  554.       with lp.LptPrinters[lp.curdest] do begin
  555.       result:=trim(Prname)+' ('+iifs(empty(Queue),PrPort,Queue)+')';
  556.       end;
  557.   end;
  558. end;
  559.  
  560. procedure LPmain.GetPrinterType(aPrinterName:string;var pType:integer;
  561.   pWideCarriage:boolean);
  562. var ii:integer;
  563.     tt,tt2:string;
  564. begin
  565.   pType:=0;
  566.   pWideCarriage:=false;
  567.     with lp do begin
  568.       if AvailCnt>0 then begin
  569.           tt:=upper(aPrinterName);
  570.           for ii:=1 to AvailCnt do begin
  571.               tt2:=upper(AvailName[ii]);
  572.                 if tt=tt2 then begin
  573.                   pType:=AvailType[ii];
  574.           pWideCarriage:=AvailWide[ii];
  575.                     break;
  576.                 end;
  577.             end;
  578.         end;
  579.     end;
  580. end;
  581.  
  582. function LPmain.GetQueueNum(ForQueue:string):Integer;
  583. var ii:integer;
  584.     tt,tt2:string;
  585. begin
  586.   result:=0;
  587.     with lp do begin
  588.       if QueueCnt>0 then begin
  589.           tt:=upper(ForQueue);
  590.           for ii:=1 to QueueCnt do begin
  591.               tt2:=upper(QueueName[ii]);
  592.                 if tt=tt2 then begin
  593.                   result:=ii;
  594.                     break;
  595.                 end;
  596.             end;
  597.         end;
  598.     end;
  599. end;
  600.  
  601. procedure Lpr.SetZeroXY(aPrType:integer);
  602. begin
  603.   { Adjust origin for each printer for PrePrintedForm's }
  604.   AdjZeroX:=0.0;
  605.   AdjZeroY:=0.0;
  606.   if PrePrintedForm then begin
  607.     case aPrType of
  608.       5,6,7,8,13:begin  { LaserJet's }
  609.         AdjZeroX:=-0.7;
  610.         AdjZeroY:=-0.95;
  611.       end;
  612.       2,3,4,12:begin  { Canon BJ-200's }
  613.         AdjZeroX:=-0.8;
  614.         AdjZeroY:=-0.65;
  615.       end;
  616.       10,11:begin    { HP DeskJet's }
  617.         AdjZeroX:=0.0;
  618.         AdjZeroY:=0.0;
  619.       end;
  620.     end;
  621.   end;
  622. end;
  623.  
  624. procedure LPmain.LoadPrinters(FromFile:string);
  625. var tt,tt2,q1,q2,q3:string;
  626.         tparscnt,ii,jj,kk:integer;
  627.         plist:tstringlist;
  628.     tp1,tp2:pchar;
  629.     tpars:array [1..MaxPars] of string135;
  630.         pr:TPrinter;
  631. begin
  632.     pr:=TPrinter.create;
  633.   plist:=tstringlist.create;
  634.   plist.LoadFromFile(FromFile);
  635.     { setup printer and queue types first }
  636.     AvailCnt:=0;
  637.     QueueCnt:=0;
  638.     for ii:=1 to MaxPrns do begin
  639.         AvailType[ii]:=0;
  640.         AvailName[ii]:='';
  641.         AvailWide[ii]:=false;
  642.         QueueName[ii]:='';
  643.         QueueTitle[ii]:='';
  644.     { -1 so it will ignore unknown printers which have PrType=0 }
  645.         for jj:=1 to MaxQTypes do QueueType[ii][jj]:=-1;
  646.     with LptPrinters[ii] do begin
  647.       PrName:='';
  648.       PrPort:='';
  649.             PrType:=0;
  650.       CanSelect:=True;
  651.       PrWide:=False;
  652.       Queue:='';
  653.     end;
  654.     end;
  655.     for ii:=0 to plist.count-1 do begin
  656.       if pos('pp:',plist[ii])=1 then begin
  657.           split(plist[ii],':',tpars,tparscnt);
  658.             pp(AvailCnt);
  659.             AvailType[AvailCnt]:=procint(tpars[2]);
  660.             AvailName[AvailCnt]:=trim(tpars[3]);
  661.             AvailWide[AvailCnt]:=pin('WIDE',upper(plist[ii]));
  662.             { always make the generice printer wide carriage }
  663.             if pin('GENERIC',upper(tpars[3])) then AvailWide[AvailCnt]:=true;
  664.         end;
  665.       if pos('qq:',plist[ii])=1 then begin
  666.           split(plist[ii],':',tpars,tparscnt);
  667.             pp(QueueCnt);
  668.             QueueName[QueueCnt]:=upper(trim(tpars[2]));
  669.             QueueTitle[QueueCnt]:=trim(tpars[3]);
  670.       split(tpars[4],',',tpars,tparscnt);
  671.       if tparscnt>MaxQTypes then begin
  672.         OKBox('Too Many Printers Defined For Queue '+QueueName[QueueCnt]);
  673.         tparscnt:=MaxQtypes;
  674.       end;
  675.             for jj:=1 to tparscnt do
  676.         QueueType[QueueCnt][jj]:=procint(tpars[jj]);
  677.         end;
  678.     end;
  679.   PrnCnt:=0;
  680.   { findout which Queues are attached to the 3 lpt ports }
  681.   q1:='';
  682.   q2:='';
  683.   q3:='';
  684.   tp1:=stralloc(60);
  685.   tp2:=stralloc(60);
  686.   strpcopy(tp1,'LPT1');
  687.   strpcopy(tp2,'');
  688.   kk:=58;  { set tp2 buffer size }
  689.   jj:=WNetGetConnection(tp1,tp2,kk);
  690.   if jj=0 then q1:=upper(strpas(tp2));
  691.   strpcopy(tp1,'LPT2');
  692.   strpcopy(tp2,'');
  693.   jj:=WNetGetConnection(tp1,tp2,kk);
  694.   if jj=0 then q2:=upper(strpas(tp2));
  695.   strpcopy(tp1,'LPT3');
  696.   strpcopy(tp2,'');
  697.   jj:=WNetGetConnection(tp1,tp2,kk);
  698.   if jj=0 then q3:=upper(strpas(tp2));
  699.     if pr.printers.count>0 then begin
  700.       for ii:=0 to pr.printers.count-1 do begin
  701.       split(pr.printers[ii],' on ',tpars,tparscnt);
  702.       { skip printer server printers and Publisher Rendering System PUB }
  703.       if PrnCnt<MaxPrns then begin
  704.         pp(PrnCnt);
  705.         with LptPrinters[PrnCnt] do begin
  706.           PrName:=trim(tpars[1]);
  707.           tt2:=PrName;
  708.           jj:=pos('(',tt2);
  709.           if jj>0 then tt2:=trim(copy(tt2,1,jj-1));
  710.           GetPrinterType(tt2,PrType,PrWide);
  711.           PrPort:=upper(tpars[2]);
  712.           CanSelect:=True;
  713.           { Ignore Print Server Printers, and MSPub Rendering Entry PUB: }
  714.           { i.e. Jeff's Shared LaserJeft }
  715.               if upin('SHARED',tpars[1]) or upin('PUB',tpars[2]) then begin
  716.                 CanSelect:=false;
  717.               end;
  718.           if (PrType=0) and (procint(PrPort)>0) and (CanSelect) then
  719.             Okbox('Need To Add '+Prname+' To '+PrnInitFile);
  720.           Queue:='';
  721.           if procint(PrPort)=1 then Queue:=q1;
  722.           if procint(PrPort)=2 then Queue:=q2;
  723.           if procint(PrPort)=3 then Queue:=q3;
  724.                     jj:=GetQueueNum(Queue);
  725.                     { Check Queue printer type matches Windows setup }
  726.                     if jj>0 then begin
  727.                         for kk:=1 to MaxQTypes do begin
  728.                             Queue:='';
  729.                             if (PrType>0) and (PrType=QueueType[jj][kk]) then begin
  730.                                 Queue:=upper(QueueName[jj]);
  731.                                 break;
  732.                             end;
  733.                         end;
  734.                     end else Queue:='';
  735.         end;
  736.       end;
  737.         end;
  738.     end;
  739.   { final result of LastHardCopy destination saved by StopLinePrinter }
  740.   WantsPreview:=true;
  741.     CurDest:=pr.printerindex+1;
  742.   strdispose(tp1);
  743.   strdispose(tp2);
  744.     pr.free;
  745.   plist.free;
  746. end;
  747.  
  748. procedure Lpr.Write(astr:string);
  749. begin
  750.   p(Line,Pcol,astr);
  751. end;
  752.  
  753. procedure Lpr.WriteLn(astr:string);
  754. begin
  755.   p(line,pCol,astr);
  756.   Col:=0;
  757.   pp(line);
  758. end;
  759.  
  760. procedure Lpr.P(atrow,atcol:integer;astr:string);
  761. var OverPGlen:boolean;
  762. begin
  763.   if Abort then Exit;
  764.     if WantsPreview then AddCommand(' 1'+Dlm+
  765.       inttostr(atrow)+Dlm+inttostr(atcol)+Dlm+astr);
  766.   OverPGlen:=false;
  767.   if atrow<Row then begin
  768.     Eject;
  769.     pp(page);
  770.   end;
  771.   if atrow>(PgLen+2) then begin
  772.     Eject;
  773.       OverPGlen:=true;
  774.     pp(page);
  775.   end;
  776.   Row:=atRow;
  777.   Col:=atcol;
  778.   if length(astr)>0 then begin
  779.     if not WantsPreview then begin
  780.       ColWidth:=iifi(Condensed,Fixed8Width,Fixed12Width);
  781.       wout(col*ColWidth,row*RowHeight,astr);
  782.     end;
  783.     Col:=Col+length(astr);
  784.   end;
  785.   if OverPGlen then begin { must not reset row and col till after print }
  786.     row:=0;
  787.     col:=0;
  788.     line:=-1;
  789.   end;
  790.     EndCommand;
  791. end;
  792.  
  793. procedure Lpr.SetDestination;
  794. { Set printer options using LPmain info.
  795.     Should be called before StartDoc(), but only once, when
  796.   the choice to print has been made, not inside a loop of any kind
  797.     because the printer destination might be changed by some other event }
  798. begin
  799.     NumOfCopies:=1;
  800.     CurDest:=lp.CurDest;
  801.   WantsPreview:=lp.WantsPreview;
  802.   WindowDest:=WantsPreview;
  803.     RpWide:=Lp.LptPrinters[curdest].PrWide;
  804. end;
  805.  
  806. procedure Lpr.StartDoc2(ToPreview,Over80Wide:boolean;
  807.                                                 aBriefTitle:string);
  808. begin
  809.   FromPreview:=ToPreview;
  810.     StartDoc(Over80Wide,aBriefTitle);
  811. end;
  812.  
  813. procedure Lpr.StartDoc(Over80Wide:boolean;aBriefTitle:string);
  814. var ii:integer;
  815.     Use70,paper8x11:boolean;
  816.     tt,tt2:string;
  817. begin
  818.     ShortTitle:=aBriefTitle;
  819.   for ii:=1 to MaxLpTitles do begin
  820.       if empty(CurPrinting[ii]) then begin
  821.           CurPrinting[ii]:=ShortTitle;
  822.             break;
  823.         end;
  824.     end;
  825.   Abort:=false;
  826.   Running:=true;
  827.   RpWide:=Over80Wide;
  828.   PgLen:=MaxPageLen;
  829.     NumOfCopies:=1;
  830.   { page starts at 0,0 }
  831.   Row:=0;
  832.   Col:=0;
  833.   Page:=1;
  834.   Line:=0;
  835.   RowHeight:=1;
  836.   ColWidth:=1;
  837.   Use70:=false;
  838.   FromLoadToPrint:=false;
  839.     Fixed12Width:=0;
  840.   Fixed8Width:=0;
  841.   CurFont:=0;
  842.     ViewPageTot:=1;
  843.     Commands[ViewPageTot]:=tstringlist.create;
  844.     pr:=TPrinter.create;
  845.     InsideCommand:=false;
  846.     if CurDest>0 then pr.printerindex:=CurDest-1;
  847.   ShortTitle:=GetTitle(aBrieftitle);
  848.   ii:=pos('::',aBriefTitle);
  849.     { wants accurate reference to units screen measurements }
  850.   Use70:=pin('70::',copy(aBriefTitle,1,ii));
  851.   if not FromPreview then begin
  852.       preview:=tpreview.create(application);
  853.         preview.caption:='Formatting '+ShortTitle;
  854.       preview.ViewPageTot:=1;
  855.       preview.panel1.width:=preview.image1.width;
  856.     Commands[ViewPageTot].insert(0,' 1'+Dlm+' 0'+Dlm+
  857.           iifs(RpWide,'for14x11','for8x11')+Dlm+Dlm+aBriefTitle);
  858.   end;
  859.     if WantsPreview then begin
  860.         WindowDest:=true;
  861.         SetZeroXY(0);
  862.         aCanvas:=Preview.image1.Canvas;
  863.     end else begin
  864.       if FromPreview then begin
  865.           if not WindowDest then begin
  866.           {if useLandScape then pr.Orientation:=poLandScape;}
  867.               SetZeroXY(lp.LptPrinters[lp.CurDest].PrType);
  868.                 pr.begindoc;
  869.           pr.fcanvas.brush.style:=bsSolid;
  870.         pr.fcanvas.brush.color:=clWhite;
  871.         pr.fcanvas.fillrect(pr.fcanvas.cliprect);
  872.                 aCanvas:=pr.fcanvas;
  873.             end;
  874.         end else begin
  875.             WindowDest:=false;
  876.             preview.caption:='Formatting '+aBriefTitle;
  877.       {if useLandScape then pr.Orientation:=poLandScape;}
  878.             SetZeroXY(lp.LptPrinters[lp.CurDest].PrType);
  879.             pr.begindoc;
  880.       pr.fcanvas.brush.style:=bsSolid;
  881.       pr.fcanvas.brush.color:=clWhite;
  882.       pr.fcanvas.fillrect(pr.fcanvas.cliprect);
  883.             aCanvas:=pr.fcanvas;
  884.         end;
  885.     end;
  886.     with aCanvas do begin
  887.         if not WindowDest then begin
  888.       paper8x11:=not Lp.LptPrinters[CurDest].PrWide;
  889.         end else begin
  890.       paper8x11:=true;
  891.         end;
  892.     if Use70 and WindowDest then SetScaleXY70 else SetScaleXY;
  893.     SetTextStyle(true);  { start in text style }
  894.         with font do begin
  895.       SetGDIFont('2:12');
  896.       Condensed:=false;
  897.       if WindowDest then SetGDIFont('2:10');
  898.             if RpWide And paper8x11 then begin
  899.         Condensed:=true;
  900.           SetGDIFont('2:8');
  901.             end;
  902.         end;
  903.     end;
  904. end;
  905.  
  906. procedure Lpr.StopDoc;
  907. var ii:integer;
  908. begin
  909.   for ii:=1 to MaxLpTitles do begin
  910.       if ShortTitle=CurPrinting[ii] then begin
  911.           CurPrinting[ii]:='';
  912.             break;
  913.         end;
  914.     end;
  915.     if not WindowDest then begin
  916.         preview.caption:='Printing '+ShortTitle;
  917.     if FromLoadToPrint then begin
  918.     { special case when commands loaded from file }
  919.         pr.Abort; { close current printer device, handled by PlayBackPage }
  920.       preview.wCurDest:=CurDest;
  921.       preview.wPageTot:=ViewPageTot;
  922.       for ii:=1 to ViewPageTot do begin
  923.         preview.wCommands[ii]:=tstringlist.create;
  924.         preview.wCommands[ii].assign(Commands[ii]);
  925.         Commands[ii].free;
  926.       end;
  927.       { keep track of StartDoc() settings }
  928.       preview.wRpWide:=RpWide;
  929.       preview.wShortTitle:=ShortTitle;
  930.       preview.playbackPage(false,0);
  931.     end else pr.EndDoc;
  932.     preview.close;
  933.     end;
  934.     pr.free;
  935.   Running:=false;
  936.   if WantsPreview then begin
  937.     preview.wCurDest:=CurDest;
  938.     preview.wPageTot:=ViewPageTot;
  939.         for ii:=1 to ViewPageTot do begin
  940.       preview.wCommands[ii]:=tstringlist.create;
  941.           preview.wCommands[ii].assign(Commands[ii]);
  942.             Commands[ii].free;
  943.         end;
  944.         { keep track of StartDoc() settings }
  945.     preview.wRpWide:=RpWide;
  946.         preview.wShortTitle:=ShortTitle;
  947.     preview.CurPage:=1;
  948.     preview.PlayBackPage(true,1);
  949.     preview.setbuttons;
  950.   end;
  951. end;
  952.  
  953. procedure Lpr.SetRowCol(toRow,toCol:integer);
  954. begin
  955.   if Abort then Exit;
  956.     if WantsPreview then AddCommand(' 2'+Dlm+inttostr(torow)+Dlm+
  957.     inttostr(tocol));
  958.   Col:=toCol;
  959.   Row:=toRow;
  960.     EndCommand;
  961. end;
  962.  
  963. procedure Lpr.CrLf;
  964. begin
  965.   if Abort then Exit;
  966.     if WantsPreview then AddCommand(' 3');
  967.     pp(Row);
  968.   Col:=0;
  969.     EndCommand;
  970. end;
  971.  
  972. procedure Lpr.Eject;
  973. begin
  974.   if Abort then Exit;
  975.     if not WindowDest then pr.newpage
  976.   else begin
  977.         if ViewPageTot<MaxPages then begin
  978.             pp(ViewPageTot);
  979.       Commands[ViewPageTot]:=tstringlist.create;
  980.     end;
  981.   end;
  982.   Row:=0;
  983.   Line:=0;
  984.   Col:=0;
  985. end;
  986.  
  987. function Lpr.pRow:integer;
  988. begin
  989.   Result:=Row;
  990. end;
  991.  
  992. function Lpr.pCol:integer;
  993. begin
  994.     Result:=Col;
  995. end;
  996.  
  997. function Lpr.SpecChars(istr:string):string;
  998. var ii,tcnt:integer;
  999.     tst:string[10];  { special chars ~ ` ^ }
  1000.         tt:string[3];
  1001.         tarr:array [1..30] of string135;
  1002. begin
  1003.   ii:=pos('+/-',istr);
  1004.   if ii>0 then begin
  1005.     tcnt:=0;
  1006.     split(istr,'+/-',tarr,tcnt);
  1007.     istr:=unsplit(tarr,'~',tcnt);
  1008.   end;
  1009.   for ii:=1 to length(istr) do begin
  1010.     tst:=Copy(istr,ii,1);
  1011.     if tst='`' then begin  { degree }
  1012.       istr[ii]:=chr(176);
  1013.     End Else
  1014.     Begin
  1015.       if tst='~' then begin  { +/- symbol }
  1016.         istr[ii]:=chr(177);
  1017.       End Else
  1018.       Begin
  1019.         if tst='^' then begin  { Greek theta character }
  1020.           istr[ii]:=chr(216);
  1021.         End Else
  1022.         Begin
  1023.           if tst='_' then begin  { replace underscores with spaces }
  1024.             istr[ii]:=' ';
  1025.           End;
  1026.         End;
  1027.       End;
  1028.     End;
  1029.   End;
  1030.   Result:=istr;
  1031. end;
  1032.  
  1033. procedure Lpr.pxTray(usetray:integer);
  1034. var p1,r1:integer;
  1035.     prt:string[20];
  1036. begin
  1037.   if Abort then Exit;
  1038.     if WantsPreview then AddCommand('28'+Dlm+inttostr(usetray))
  1039.   else begin
  1040.       { not written yet }
  1041.   end;
  1042.     EndCommand;
  1043. end;
  1044.  
  1045. function cmX(Centimeters:double):integer; { centimeters to ref. pixels }
  1046. var ii:integer;
  1047. begin
  1048.   ii:=procint(strd((Centimeters*RefAspectXdbl)/2.54,0));
  1049.   result:=ii;
  1050. end;
  1051.  
  1052. function cmY(Centimeters:double):integer; { centimeters to ref. pixels }
  1053. var ii:integer;
  1054. begin
  1055.   ii:=procint(strd((Centimeters*RefAspectYdbl)/2.54,0));
  1056.   result:=ii;
  1057. end;
  1058.  
  1059. procedure Lpr.cmLine(left,top,width,height:double);
  1060. begin
  1061.     pxLine(Rect(cmX(left+AdjZeroX),cmY(top+AdjZeroY),cmX(width),cmY(height)));
  1062. end;
  1063.  
  1064. procedure Lpr.cmBox(left,top,width,height:double;graylev:integer);
  1065. begin
  1066.     pxBox(Rect(cmX(left+AdjZeroX),cmY(top+AdjZeroY),cmX(width),
  1067.     cmY(height)),GrayLev);
  1068. end;
  1069.  
  1070. procedure Lpr.cmText(left,top:double;uzfont,thetext:string);
  1071. begin
  1072.     pxText(Point(cmX(left+AdjZeroX),cmY(top+AdjZeroY)),uzFont,TheText);
  1073. end;
  1074.  
  1075. procedure Lpr.cmImage(IsColor:boolean;left,top:double;ScrnBMP,PrintBMP:string);
  1076. begin
  1077.     pxImage(IsColor,Rect(cmX(left+AdjZeroX),cmY(top+AdjZeroY),0,0),
  1078.     ScrnBMP,PrintBMP);
  1079. end;
  1080.  
  1081. procedure Lpr.cmBarCode(left,top,width,height:double;Text:string);
  1082. begin
  1083.     pxBarCode(Rect(cmX(left+AdjZeroX),cmY(top+AdjZeroY),cmX(width),
  1084.     cmY(height)),Text);
  1085. end;
  1086.  
  1087. procedure Lpr.pxRaster(Left,Top,Width,Height,Density:integer;FileName:string);
  1088. var tb,tb2:TBitmap;
  1089.     map:tstringlist;
  1090.     tt:string;
  1091.     ii,jj,kk,zz,ll,ypos,xpos,tox,toy,shift:integer;
  1092.     fromrect,torect:trect;
  1093.     lcolor:longint;
  1094. begin
  1095.   if Abort then Exit;
  1096.   if WantsPreview then AddCommand('29'+Dlm+
  1097.     ltrim(stri(left,5))+Dlm+ltrim(stri(top,5))+Dlm+
  1098.     ltrim(stri(width,5))+Dlm+ltrim(stri(height,5))+Dlm+
  1099.     ltrim(stri(density,5))+Dlm+FileName)
  1100.   else begin
  1101.     if not FileExists(FileName) then begin
  1102.       OKbox('pxRaster, File Not Found: '+FileName);
  1103.       exit;
  1104.     end;
  1105.     tb:=tbitmap.create;
  1106.     tb2:=tbitmap.create;
  1107.     tb.canvas.brush.style:=bsSolid;
  1108.     tb.canvas.brush.color:=clWhite;
  1109.     tb.canvas.fillrect(tb.canvas.cliprect);
  1110.     map:=tstringlist.create;
  1111.     map.loadfromfile(FileName);
  1112.     tb.height:=300;
  1113.     tb.width:=300;
  1114.     tb2.height:=ScaleY(height);
  1115.     tb2.width:=ScaleX(width);
  1116.     shift:=1;
  1117.     if density=75 then shift:=4;
  1118.     if density=150 then shift:=2;
  1119.     ii:=-1;
  1120.     ypos:=0;
  1121.     while ii<map.count-1 do begin
  1122.       ii:=ii+1;
  1123.       tt:=map[ii];
  1124.       ll:=length(tt);
  1125.       toy:=ypos+shift-1;
  1126.       for zz:=ypos to toy do begin
  1127.         with tb.canvas do begin
  1128.           xpos:=0;
  1129.           for jj:=1 to ll do begin
  1130.             if tt[jj]<>'.' then begin
  1131.               lcolor:=clBlack;
  1132.             end else begin
  1133.               lcolor:=clWhite;
  1134.             end;
  1135.             { fill in gaps with last color }
  1136.             tox:=xpos+shift-1;
  1137.             for kk:=xpos to tox do begin
  1138.               pixels[kk,zz]:=lcolor;
  1139.             end;
  1140.             xpos:=xpos+shift;
  1141.           end;
  1142.         end;
  1143.       end;
  1144.       ypos:=ypos+shift;
  1145.     end;
  1146.     fromrect:=rect(0,0,xpos,ypos);
  1147.     tb2.canvas.CopyRect(tb2.canvas.cliprect,tb.canvas,fromrect);
  1148.     aCanvas.Draw(ScaleX(left),ScaleY(top),tb2);
  1149.     map.free;
  1150.     tb.free;
  1151.     tb2.free;
  1152.   end;
  1153.   EndCommand;
  1154. end;
  1155.  
  1156. procedure Lpr.pxLine(aRect:Trect);
  1157. begin
  1158.   if Abort then Exit;
  1159.   if WantsPreview then begin
  1160.     AddCommand('21'+Dlm+
  1161.         ltrim(stri(arect.left,5))+Dlm+ltrim(stri(arect.top,5))+Dlm+
  1162.         ltrim(stri(arect.right,5))+Dlm+ltrim(stri(arect.bottom,5)));
  1163.   end else begin
  1164.     with aCanvas do begin
  1165.       { if right>bottom then horizontal line }
  1166.       if arect.right>arect.bottom then pen.width:=arect.bottom
  1167.       else pen.width:=arect.right;
  1168.       if WindowDest then pen.width:=1;
  1169.       brush.style:=bsClear;
  1170.       moveto(ScaleX(arect.left),ScaleY(arect.top));
  1171.       if arect.right>arect.bottom then  { horizontal line }
  1172.         lineto(ScaleX(arect.left+arect.right),ScaleY(arect.top))
  1173.       else                  { vertical line }
  1174.         lineto(ScaleX(arect.left),ScaleY(arect.top+arect.bottom));
  1175.     end;
  1176.   end;
  1177.     EndCommand;
  1178. end;
  1179.  
  1180. procedure Lpr.pxBox(aRect:Trect;GrayLev:integer);
  1181. begin
  1182.   if Abort then Exit;
  1183.   if WantsPreview then AddCommand('22'+Dlm+
  1184.     ltrim(stri(arect.left,5))+Dlm+ltrim(stri(arect.top,5))+Dlm+
  1185.     ltrim(stri(arect.right,5))+Dlm+ltrim(stri(arect.bottom,5))+Dlm+
  1186.     ltrim(stri(graylev,5)))
  1187.   else begin
  1188.     with aCanvas do begin
  1189.       { if i3>i4 then its a horizontal box }
  1190.       brush.style:=bsSolid;
  1191.       if graylev=0 then brush.color:=clBlack else
  1192.         if graylev=1 then brush.color:=clWhite else begin
  1193.           { must use Yellow when printing light gray on paper }
  1194.           if WindowDest then brush.color:=clAqua else brush.color:=clYellow;
  1195.         end;
  1196.       fillrect(rect(ScaleX(arect.left),ScaleY(arect.top),
  1197.         ScaleX(arect.left+arect.right),ScaleY(arect.top+arect.bottom)));
  1198.     end;
  1199.   end;
  1200.     EndCommand;
  1201. end;
  1202.  
  1203. procedure Lpr.pxOrientation(newOrientation:TPrinterOrientation);
  1204. begin
  1205.   if Abort then Exit;
  1206.   if WantsPreview then AddCommand('26'+Dlm+
  1207.       iifs(newOrientation=poPortrait,'PORTRAIT','LANDSCAPE'))
  1208.     else begin
  1209.       if Not WindowDest then begin
  1210.           pr.Orientation:=newOrientation;
  1211.       pr.fcanvas.brush.style:=bsSolid;
  1212.       pr.fcanvas.brush.color:=clWhite;
  1213.       pr.fcanvas.fillrect(pr.fcanvas.cliprect);
  1214.           aCanvas:=pr.fCanvas;
  1215.         end;
  1216.     end;
  1217.   EndCommand;
  1218. end;
  1219.  
  1220. procedure DirectToPrinter(anEscSeq:string);
  1221. var ii:integer;
  1222.     tt:pchar;
  1223.     tlp:TPrinter;
  1224. begin
  1225.   tlp:=TPrinter.create;
  1226.   tlp.printerindex:=lp.CurDest-1;
  1227.   tlp.begindoc;
  1228.   tt:=stralloc(260);
  1229.   strpcopy(tt,anEscSeq);
  1230.   ii:=Escape(tlp.handle,PASSTHROUGH,length(anEscSeq),tt,nil);
  1231.   tlp.enddoc;
  1232.   StrDispose(tt);
  1233.   tlp.free;
  1234. end;
  1235.  
  1236. procedure Lpr.pxImage(IsColor:boolean;aRect:Trect;ScrnBMP,PrintBMP:string);
  1237. var MustScale:boolean;
  1238.     tt:string;
  1239.     tim:tbitmap;
  1240.     ii,jj:integer;
  1241. begin
  1242.   if Abort then Exit;
  1243.   if WantsPreview then AddCommand('25'+Dlm+iifs(IsColor,'TRUE','FALSE')+Dlm+
  1244.     ltrim(stri(arect.left,5))+Dlm+ltrim(stri(arect.top,5))+Dlm+
  1245.     ltrim(stri(arect.right,5))+Dlm+ltrim(stri(arect.bottom,5))+Dlm+
  1246.     ScrnBMP+Dlm+PrintBMP)
  1247.   else begin
  1248.     tim:=tbitmap.create;
  1249.     ii:=ScaleX(arect.left);
  1250.     jj:=ScaleY(arect.top);
  1251.     if WindowDest then begin
  1252.           if not empty(ScrnBMP) then begin
  1253.         tim.loadfromfile(ScrnBMP);
  1254.               aCanvas.Draw(ii,jj,tim);
  1255.       end;
  1256.     end else begin
  1257.           if not empty(PrintBMP) then begin
  1258.               tim.loadfromfile(PrintBMP);
  1259.               aCanvas.Draw(ii,jj,tim);
  1260.       end;
  1261.     end;
  1262.     tim.free;
  1263.   end;
  1264.   EndCommand;
  1265. end;
  1266.  
  1267. procedure TPreview.ShowBigImage;
  1268. var tt,ll:integer;
  1269.     halfx,halfy,adjx,adjy,tx,ty:double;
  1270.     tr:trect;
  1271. begin
  1272.   if FitToScreen then begin
  1273.     image1.visible:=false;
  1274.     image2.visible:=true;
  1275.       SetButtons;
  1276.   end else begin
  1277.     image2.visible:=false;
  1278.     if FirstTimeBig then MouseWait;
  1279.     with image1 do begin
  1280.         adjx:=Gen.FullBP.width/width;
  1281.         adjy:=Gen.FullBP.height/height;
  1282.       { adjust BigX and BigY to correct relative position }
  1283.       tx:=BigX;
  1284.       ty:=BigY;
  1285.       { Scale X and Y from Image coords to Bitmap position }
  1286.       tX:=tX*adjx;
  1287.       tY:=tY*adjy;
  1288.       halfx:=width div 2;
  1289.       halfy:=height div 2;
  1290.       { set X dimensions }
  1291.             ll:=procint(strd(tX-halfx,0));
  1292.       if ll<0 then ll:=0;
  1293.       if ll>(gen.fullBP.width-width) then ll:=gen.fullBP.width-width;
  1294.       { set Y dimensions }
  1295.             tt:=procint(strd(tY-halfy,0));
  1296.       if tt<0 then tt:=0;
  1297.       if tt>(gen.fullBP.height-height) then tt:=gen.fullBP.height-height;
  1298.       tr:=rect(ll,tt,ll+width-1,tt+height-1);
  1299.           canvas.copyrect(canvas.cliprect,Gen.FullBP.canvas,tr);
  1300.       if ll>0 then button1.enabled:=true
  1301.       else button1.enabled:=false;
  1302.       if tt>0 then button3.enabled:=true
  1303.       else button3.enabled:=false;
  1304.       if ll<(gen.fullBP.width-width) then button4.enabled:=true
  1305.       else button4.enabled:=false;
  1306.       if tt<(gen.fullBP.height-height) then button2.enabled:=true
  1307.       else button2.enabled:=false;
  1308.         visible:=true;
  1309.       DoEvents;
  1310.         if FirstTimeBig then MouseGo;
  1311.       FirstTimeBig:=false;
  1312.     end;
  1313.   end;
  1314. end;
  1315.  
  1316. procedure lpr.SetCaption(toStr:string);
  1317. { call before StopDoc }
  1318. begin
  1319.   ShortTitle:=toStr;
  1320. end;
  1321.  
  1322. procedure TPreview.ShowBluePrint(aCaption,TinyBMP,FullBMP:string);
  1323. begin
  1324.   if Gen.InBluePrint then begin
  1325.     OKbox('Can Only Have One Blue Print Open At A Time');
  1326.     close;
  1327.   end else begin
  1328.         windowstate:=wsNormal;
  1329.     Gen.InBluePrint:=true;
  1330.       Zoomable:=true;
  1331.     image1.width:=613;
  1332.     image1.height:=337;
  1333.     image2.width:=613;
  1334.     image2.height:=337;
  1335.        panel1.width:=image1.width;
  1336.     label1.caption:='Move>';
  1337.        button3.caption:='&Up';
  1338.        button2.caption:='&Down';
  1339.     button1.caption:='&Left';
  1340.        button4.caption:='&Right';
  1341.     caption:=aCaption;
  1342.       FitToScreen:=true;
  1343.       Gen.TinyBP.loadfromfile(TinyBmp);
  1344.       Gen.TinyBP.monochrome:=true;
  1345.       image2.canvas.draw(0,0,Gen.TinyBP);
  1346.       Gen.FullBP.loadfromfile(FullBmp);
  1347.     FirstTimeBig:=true;
  1348.     show;
  1349.       ShowBigImage;
  1350.   end;
  1351. end;
  1352.  
  1353. procedure Lpr.pxText(aPoint:TPoint;uzFont,TheText:string);
  1354. var curcol,atline:integer;
  1355.         tt1,tt2,msg:string135;
  1356.     i1,i2:longint;
  1357. begin
  1358.   if Abort then Exit;
  1359.     with aPoint do begin
  1360.         if WantsPreview then AddCommand('24'+Dlm+
  1361.             ltrim(stri(x,5))+Dlm+ltrim(stri(y,5))+Dlm+uzfont+Dlm+thetext)
  1362.         else begin
  1363.             with aCanvas do begin
  1364.                 setGDIfont(uzfont);
  1365.                 brush.style:=bsClear;
  1366.                 wout(ScaleX(x),ScaleY(y),thetext);
  1367.             end;
  1368.         end;
  1369.     end;
  1370.     EndCommand;
  1371. end;
  1372.  
  1373. procedure Lpr.pxBarCode(aRect:Trect;Text:string);
  1374. begin
  1375.   if Abort then Exit;
  1376.   if WantsPreview then AddCommand('27'+Dlm+
  1377.     stri(arect.left,5)+Dlm+stri(arect.top,5)+Dlm+stri(arect.right,5)+Dlm+
  1378.     stri(arect.bottom,5)+Dlm+text)
  1379.   else begin
  1380.   end;
  1381.   EndCommand;
  1382. end;
  1383.  
  1384. procedure Lpr.TextFont(NewFont:string);
  1385. begin
  1386.   if Abort then Exit;
  1387.   SetTextStyle(true);
  1388.     if WantsPreview then AddCommand(' 4'+Dlm+NewFont)
  1389.   else SetGDIfont(NewFont);
  1390.     EndCommand;
  1391. end;
  1392.  
  1393. function Lpr.Cancel:integer;  { usually found in FormClose method }
  1394. var bool:boolean;
  1395. begin
  1396.   Result:=0;
  1397.   if Running then begin
  1398.     bool:=YesNoBox('Cancel Printing');
  1399.     if bool then begin
  1400.       result:=2;  { abort }
  1401.       OKBox('After ''Wait'' Clears, You May Continue');
  1402.     end else result:=1;  { continue formatting }
  1403.   end;
  1404.   CancelState:=Result;
  1405. end;
  1406.  
  1407. procedure StartLinePrinter;
  1408. var ii:integer;
  1409. begin
  1410.   Lp:=LPmain.Create;
  1411.   for ii:=1 to MaxFonts do lp.FontList[ii]:='';
  1412.   lp.FontList[1]:='Courier New';
  1413.     { from TypeCase 2001 fonts CD collection }
  1414.   {lp.FontList[2]:='Corporate Mono';
  1415.   lp.FontList[3]:='Corporate Mono Bold';}
  1416.   { variable width fonts are subscripts over 5 }
  1417.   lp.FontList[6]:='Arial';
  1418.   { setup local printer type }
  1419.     Lp.LoadPrinters(compath(PrnInitFile));
  1420. end;
  1421.  
  1422. procedure StopLinePrinter;
  1423. var ii:integer;
  1424. begin
  1425.   Lp.free;
  1426. end;
  1427.  
  1428. procedure Lpr.AddCommand(CommandStr:string);
  1429. begin
  1430.   if not InsideCommand then begin
  1431.       InsideCommand:=true;
  1432.     { if using command below, "ff" in PlayBackPage S/B 3 }
  1433.     {Commands[ViewPageTot].add(stri(ViewPageTot,2)+Dlm+
  1434.       stri(Commands[ViewPageTot].count+1,3)+Dlm+CommandStr); }
  1435.  
  1436.     { if using command below, "ff" in PlayBackPage S/B 2 }
  1437.     Commands[ViewPageTot].add(stri(ViewPageTot,2)+Dlm+CommandStr);
  1438.  
  1439.     { Why 2 ways? I have a frequent short report that only takes up a half
  1440.       page, I store the results of the first in the top half, the next in
  1441.       the bottom half.  Then I use AddStrings() and Sort to merge the two
  1442.       pages before finally printing. }
  1443.     end;
  1444. end;
  1445.  
  1446. procedure Lpr.EndCommand;
  1447. begin
  1448.     InsideCommand:=false;
  1449. end;
  1450.  
  1451. procedure TPreview.LoadCommands(fromFile:string);
  1452. var LoadList:Tstringlist;
  1453.          ii,jj:integer;
  1454. begin
  1455.   LoadList:=tstringlist.create;
  1456.   LoadList.loadfromfile(fromFile);
  1457.   wPageTot:=0;
  1458.   for jj:=1 to MaxPages do begin
  1459.     if wCommands[jj]<>nil then wCommands[jj].clear;
  1460.   end;
  1461.   for jj:=0 to LoadList.Count-1 do begin
  1462.     ii:=strtoint(copy(LoadList[jj],1,2));
  1463.     if ii<1 then ii:=1;
  1464.     if wCommands[ii]=nil then wCommands[ii]:=tstringlist.create;
  1465.     wCommands[ii].Add(LoadList[jj]);
  1466.     if ii>wPageTot then wPageTot:=ii;
  1467.   end;
  1468.   LoadList.free;
  1469. end;
  1470.  
  1471. procedure TPreview.SaveCommands(toFile:string);
  1472. var SaveList:Tstringlist;
  1473.          jj:integer;
  1474. begin
  1475.   SaveList:=tstringlist.create;
  1476.   for jj:=1 to wPageTot do SaveList.AddStrings(wCommands[jj]);
  1477.   SaveList.savetofile(toFile);
  1478.   SaveList.free;
  1479. end;
  1480.  
  1481. function TPreview.PlayBackPage(ToScreen:boolean;PageNum:integer):boolean;
  1482. var lpp:Lpr;
  1483.     pcnt,opt,ii,jj,ff,start,finish:integer;
  1484.         pstr:array [1..10] of string135;
  1485.     tt,tt2:string;
  1486. begin
  1487.   { if Pagenum=0 then print all pages }
  1488.   lpp:=Lpr.Create;
  1489.   lpp.SetDestination;
  1490.   with lpp do begin
  1491.     CurDest:=wCurDest;
  1492.     WantsPreview:=false;
  1493.     WindowDest:=ToScreen;
  1494.     start:=PageNum;
  1495.     finish:=PageNum;
  1496.     if PageNum=0 then begin
  1497.         start:=1;
  1498.         finish:=wPageTot;
  1499.     end;
  1500.         if ToScreen then begin
  1501.             if empty(wShortTitle) then caption:='Preview'
  1502.                 else caption:=GetTitle(trim(wShortTitle));
  1503.       windowstate:=wsNormal;
  1504.           aCanvas:=image1.canvas;
  1505.             StartDoc2(ToScreen,wRpWide,wShortTitle);
  1506.         end else begin
  1507.             if empty(wShortTitle) then lpp.preview.caption:='Printing'
  1508.                 else lpp.preview.caption:='Printing '+trim(wShortTitle);
  1509.       lpp.useLandScape:=self.useLandScape;
  1510.           StartDoc(wRpWide,wShortTitle);
  1511.         end;
  1512.     { debug line}
  1513.     {if Gen.User='BRAD ' then SaveCommands(TempPath('commands.txt'));}
  1514.     for ii:=start to finish do begin
  1515.           { find first entry }
  1516.       if ToScreen then begin
  1517.           image1.canvas.brush.style:=bsSolid;
  1518.         image1.canvas.brush.color:=clWhite;
  1519.         image1.canvas.fillrect(image1.canvas.cliprect);
  1520.         image1.visible:=false;
  1521.         label2.caption:='Pg '+ltrim(stri(start,3))+
  1522.           ' of '+ltrim(stri(wPageTot,3));
  1523.         MouseWait;
  1524.       end;
  1525.             if wCommands[ii].count>0 then begin
  1526.               for jj:=0 to wCommands[ii].count-1 do begin
  1527.           doevents2;
  1528.                     split(wCommands[ii][jj],Dlm,pstr,pcnt);
  1529.           ff:=2;   { first field after page number and/or sequence no. }
  1530.                     opt:=procint(pstr[ff]);
  1531.                     case opt of
  1532.              { Row,Col style reports }
  1533.                        1:p(procint(pstr[ff+1]),procint(pstr[ff+2]),pstr[ff+3]);
  1534.                        2:SetRowCol(procint(pstr[ff+1]),procint(pstr[ff+2]));
  1535.                        3:CrLf;
  1536.                        4:TextFont(pstr[ff+1]);
  1537.              { Special Commands }
  1538.                        5:SetTextStyle(pin('TRUE',pstr[ff+1]));
  1539.                       10:DirectToPrinter(pstr[ff+1]);
  1540.                       { Raster style reports, called by above }
  1541.                       21:pxLine(Rect(procint(pstr[ff+1]),procint(pstr[ff+2]),
  1542.                  procint(pstr[ff+3]),procint(pstr[ff+4])));
  1543.                       22:pxBox(Rect(procint(pstr[ff+1]),procint(pstr[ff+2]),
  1544.                  procint(pstr[ff+3]),procint(pstr[ff+4])),procint(pstr[ff+5]));
  1545.                          24:pxText(Point(procint(pstr[ff+1]),procint(pstr[ff+2])),pstr[ff+3],
  1546.                  pstr[ff+4]);
  1547.                         25:begin
  1548.                  pxImage(pin('TRUE',pstr[ff+1]),Rect(procint(pstr[ff+2]),
  1549.                    procint(pstr[ff+3]),procint(pstr[ff+4]),
  1550.                    procint(pstr[ff+5])),pstr[ff+6],pstr[ff+7]);
  1551.                end;
  1552.                         26:begin
  1553.                              if pin('PORTRAIT',pstr[ff+1]) then
  1554.                                      pxOrientation(poPortrait)
  1555.                                  else
  1556.                                      pxOrientation(poLandScape);
  1557.                              end;
  1558.                         27:pxBarCode(Rect(procint(pstr[ff+1]),procint(pstr[ff+2]),
  1559.                  procint(pstr[ff+3]),procint(pstr[ff+4])),pstr[ff+5]);
  1560.                       28:pxTray(procint(pstr[ff+1]));
  1561.             29:pxRaster(procint(pstr[ff+1]),procint(pstr[ff+2]),
  1562.                  procint(pstr[ff+3]),procint(pstr[ff+4]),
  1563.                  procint(pstr[ff+5]),pstr[ff+6]);
  1564.                     end;
  1565.                 end;
  1566.             end else OKbox('Page '+inttostr(ii)+' Is Blank');
  1567.       { last page Eject in StopDoc }
  1568.       if ToScreen then begin
  1569.         MouseGo;
  1570.         image1.visible:=true;
  1571.       end;
  1572.             if not ToScreen and (ii<finish) then Eject;
  1573.     end;
  1574.         StopDoc;
  1575.   end;
  1576.     result:=(lpp.CancelState<>2);  { not cancelled }
  1577.   lpp.free;
  1578. end;
  1579.  
  1580. procedure TPreview.BitBtn6Click(Sender: TObject);
  1581. begin
  1582.   PlayBackPage(false,0);
  1583. end;
  1584.  
  1585. procedure TPreview.BitBtn1Click(Sender: TObject);
  1586. begin
  1587.   PlayBackPage(false,CurPage);
  1588. end;
  1589.  
  1590. procedure TPreview.Button3Click(Sender: TObject);
  1591. begin
  1592.   if zoomable then begin
  1593.     BigY:=BigY-ScrollPixels;
  1594.     if BigY<0 then BigY:=0;
  1595.     ShowBigImage;
  1596.   end else begin
  1597.       Curpage:=1;
  1598.       PlayBackPage(true,1);
  1599.       SetButtons;
  1600.   end;
  1601. end;
  1602.  
  1603. procedure TPreview.Button4Click(Sender: TObject);
  1604. begin
  1605.   if zoomable then begin
  1606.     BigX:=BigX+ScrollPixels;
  1607.     ShowBigImage;
  1608.   end else begin
  1609.       CurPage:=wPageTot;
  1610.       PlayBackPage(true,CurPage);
  1611.       SetButtons;
  1612.   end;
  1613. end;
  1614.  
  1615. procedure TPreview.Button2Click(Sender: TObject);
  1616. begin
  1617.   if zoomable then begin
  1618.     BigY:=BigY+ScrollPixels;
  1619.     ShowBigImage;
  1620.   end else begin
  1621.       if CurPage>1 then begin
  1622.         CurPage:=CurPage-1;
  1623.         PlayBackPage(true,CurPage);
  1624.           SetButtons;
  1625.       end;
  1626.   end;
  1627. end;
  1628.  
  1629. procedure TPreview.Button1Click(Sender: TObject);
  1630. begin
  1631.   if zoomable then begin
  1632.     BigX:=BigX-ScrollPixels;
  1633.     if BigX<0 then BigX:=0;
  1634.     ShowBigImage;
  1635.   end else begin
  1636.       if CurPage<wPageTot then begin
  1637.         CurPage:=CurPage+1;
  1638.         PlayBackPage(true,CurPage);
  1639.         SetButtons;
  1640.         end;
  1641.   end;
  1642. end;
  1643.  
  1644. procedure TPreview.Edit1KeyPress(Sender: TObject; var Key: Char);
  1645. var ii:integer;
  1646. begin
  1647.   if getret(key) then begin
  1648.     ii:=procint(edit1.text);
  1649.     if (ii>0) and (ii<=wPageTot) then begin
  1650.         CurPage:=ii;
  1651.         PlayBackPage(true,CurPage);
  1652.         SetButtons;
  1653.       end;
  1654.   end;
  1655. end;
  1656.  
  1657. procedure TPreview.SetButtons;
  1658. begin
  1659.   if Zoomable then begin
  1660.     button1.enabled:=not FitToScreen;
  1661.     button2.enabled:=not FitToScreen;
  1662.     button3.enabled:=not FitToScreen;
  1663.     button4.enabled:=not FitToScreen;
  1664.     { set popupmenu choices }
  1665.     Firstpg1.enabled:=false;
  1666.     Previouspg1.enabled:=false;
  1667.     bitbtn6.enabled:=false;
  1668.     gotopg1.enabled:=false;
  1669.     bitbtn1.enabled:=false;
  1670.     printall1.enabled:=false;
  1671.     printpg1.enabled:=false;
  1672.     Nextpg1.enabled:=false;
  1673.     Lastpg1.enabled:=false;
  1674.     edit1.enabled:=false;
  1675.   end else begin
  1676.     if wPageTot=1 then begin
  1677.       button1.enabled:=false;
  1678.       button2.enabled:=false;
  1679.       button3.enabled:=false;
  1680.       button4.enabled:=false;
  1681.       { set popupmenu choices }
  1682.       Firstpg1.enabled:=false;
  1683.       Previouspg1.enabled:=false;
  1684.       bitbtn6.enabled:=false;
  1685.       gotopg1.enabled:=false;
  1686.       printall1.enabled:=false;
  1687.       Nextpg1.enabled:=false;
  1688.       Lastpg1.enabled:=false;
  1689.       edit1.enabled:=false;
  1690.     end else begin
  1691.       button1.enabled:=true;
  1692.       button2.enabled:=true;
  1693.       button3.enabled:=true;
  1694.       button4.enabled:=true;
  1695.       Firstpg1.enabled:=true;
  1696.       Previouspg1.enabled:=true;
  1697.       Nextpg1.enabled:=true;
  1698.       Lastpg1.enabled:=true;
  1699.       edit1.enabled:=true;
  1700.       bitbtn6.enabled:=true;
  1701.       gotopg1.enabled:=true;
  1702.       printall1.enabled:=true;
  1703.       if CurPage=1 then begin
  1704.         button3.enabled:=false;
  1705.         button2.enabled:=false;
  1706.         Firstpg1.enabled:=false;
  1707.         Previouspg1.enabled:=false;
  1708.       end;
  1709.       if CurPage=wPageTot then begin
  1710.         button4.enabled:=false;
  1711.         button1.enabled:=false;
  1712.         Nextpg1.enabled:=false;
  1713.         Lastpg1.enabled:=false;
  1714.       end;
  1715.     end;
  1716.   end;
  1717. end;
  1718.  
  1719. procedure Lpr.ForceToScreen;
  1720. begin
  1721.   { override current print dest., force report to Report Preview }
  1722.   WantsPreview:=true;
  1723.   WindowDest:=true;
  1724. end;
  1725.  
  1726. procedure Lpr.ForceToPrinter;
  1727. begin
  1728.   { override current print dest., force report to a printer }
  1729.   WantsPreview:=false;
  1730.   WindowDest:=false;
  1731. end;
  1732.  
  1733. procedure TPreview.Close1Click(Sender: TObject);
  1734. begin
  1735.   Close;
  1736. end;
  1737.  
  1738. procedure TPreview.FirstPg1Click(Sender: TObject);
  1739. begin
  1740.   Curpage:=1;
  1741.   PlayBackPage(true,1);
  1742.   SetButtons;
  1743. end;
  1744.  
  1745. procedure TPreview.PreviousPg1Click(Sender: TObject);
  1746. begin
  1747.   if CurPage>1 then begin
  1748.     CurPage:=CurPage-1;
  1749.     PlayBackPage(true,CurPage);
  1750.       SetButtons;
  1751.   end;
  1752. end;
  1753.  
  1754. procedure TPreview.NextPg1Click(Sender: TObject);
  1755. begin
  1756.   if CurPage<wPageTot then begin
  1757.     CurPage:=CurPage+1;
  1758.     PlayBackPage(true,CurPage);
  1759.     SetButtons;
  1760.     end;
  1761. end;
  1762.  
  1763. procedure TPreview.LastPg1Click(Sender: TObject);
  1764. begin
  1765.   CurPage:=wPageTot;
  1766.   PlayBackPage(true,CurPage);
  1767.   SetButtons;
  1768. end;
  1769.  
  1770. procedure TPreview.PrintAll1Click(Sender: TObject);
  1771. begin
  1772.   PlayBackPage(false,0);
  1773. end;
  1774.  
  1775. procedure TPreview.PrintPg1Click(Sender: TObject);
  1776. begin
  1777.   PlayBackPage(false,CurPage);
  1778. end;
  1779.  
  1780. procedure TPreview.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  1781.   Shift: TShiftState; X, Y: Integer);
  1782. begin
  1783.   if zoomable then begin
  1784.     FitToScreen:=not FitToScreen;
  1785.       BigX:=x;
  1786.       BigY:=Y;
  1787.       ShowBigImage;
  1788.   end;
  1789. end;
  1790.  
  1791. procedure TPreview.Image2MouseUp(Sender: TObject; Button: TMouseButton;
  1792.   Shift: TShiftState; X, Y: Integer);
  1793. begin
  1794.   if zoomable then begin
  1795.       FitToScreen:=not FitToScreen;
  1796.       BigX:=x;
  1797.       BigY:=Y;
  1798.       ShowBigImage;
  1799.   end;
  1800. end;
  1801.  
  1802. procedure TPreview.GoToPg1Click(Sender: TObject);
  1803. var ii:integer;
  1804. begin
  1805.   ii:=procint(InputBox('Go To','Page #',''));
  1806.   if (ii>0) and (ii<=wPageTot) then begin
  1807.     CurPage:=ii;
  1808.     PlayBackPage(true,CurPage);
  1809.     SetButtons;
  1810.   end;
  1811. end;
  1812.  
  1813. procedure TPreview.PrintCommandFile(aLoadSpec:string);
  1814. var ii:integer;
  1815.     tt,tt2:string;
  1816. begin
  1817.     ii:=pos('::',upper(aLoadSpec));
  1818.   if ii>0 then begin
  1819.         tt:=ltrim(trim(substr(aLoadSpec,ii+2,70)));
  1820.     wShortTitle:=aLoadSpec;
  1821.         if not FileExists(tt) then begin
  1822.       OkBox('Pre-Load File Not Found: '+tt);
  1823.       close;
  1824.         end else begin
  1825.             LoadCommands(tt);
  1826.         wCurDest:=lp.curdest;
  1827.           wShortTitle:=wCommands[1][0];
  1828.           wRpWide:=pin('for14x11',wShortTitle);
  1829.             if lp.WantsPreview then begin
  1830.                 windowstate:=wsNormal;
  1831.               PlayBackPage(true,1);  { start with page 1 }
  1832.         SetButtons;
  1833.             end else begin
  1834.                 windowstate:=wsMinimized;
  1835.               PlayBackPage(false,0);
  1836.         close;
  1837.             end;
  1838.         end;
  1839.     end;
  1840. end;
  1841.  
  1842. procedure TPreview.FormActivate(Sender: TObject);
  1843. begin
  1844.   Label5.caption:=lp.CurrentPrinterInfo;
  1845. end;
  1846.  
  1847. end.
  1848.